Background

Row

Click the image below to learn more about the Oregon Child Abuse Prevalence Study Pilot, conducted by the University of Oregon’s Center for Prevention of Abuse and Neglect.

Row

Policymakers and funders rely heavily on state-wide child maltreatment data to prioritize public concerns, enact policy, and establish budgets for evidence-based programming (PEW Data Report, 2018). As such, the accurate translation of analyses with such data into visually compelling, easily digestible means is a critical pre-requisite to bridging the gap between advocates, researchers, and legislative bodies. In Oregon these data are dependent on either retrospective surveys with adults (Oregon BRFFS), youth convenience sample surveys with fewer than 10 abuse and neglect items (Oregon Healthy Teens Survey, Oregon Student Wellness Survey), and reports to child protective services (Children’s Bureau, 2019). This critical need for accurate data is met by a glaring gap as researchers and advocates agree that child maltreatment rates in the United States are significantly underreported (Swahn et al., 2006; Flaherty et al., 2008). University of Oregon’s Center for the Prevention of Abuse and Neglect (CPAN) implemented a pilot study to determine safer, more accurate methods of data collection in the school setting. Partnered with the Oregon Department of Education and multiple statewide agencies and advocacy groups, CPAN is currently implementing the first state-wide representative survey of abuse experiences with 1500-1800 youth in Oregon, to be completed in June 2021.

Abuse Rates

Column

Background

It’s valuable to see how abuse rates across school districts in Lane County vary by gender identity. Often times, those who identify as non-binary are not inlcuded in analyses and visualizations due to small samples. A violin plot was helpful in visualizing the varying distributions by gender, but requires some thinking to fully understand. The final plot builds on the simplicity of the bar plot by allowing the reader to compare average scores across all three genders.

Version 1

Version 2

Switched to bar plot, and collapsed gender variable.

Column

Final Version

Community Response

Column {data-height= 500}

Final Version

Column

Background

Researchers and policy makers alike are often hesitant to ask participants about their experiences in vulnerable settings (e.g., school) because they don’t want to trigger any past trauma. It’s helpful to see that when students tell others about their experience, the responses are often positive.

Using ggplot rather than the base Likert function in R, allows for “easy” modifcation of plot parameters. The first plot is clear, but is not malleable to changes in size or margins. The final plot builds on the stacked bar plot by layering agreeable responses over negatively coded disagreeable responses, across line. Given the very few disagreeable responses, it made greater sense to sum “Agree with Strongly Agree” and “Disagree with Strongly Disagree” rather than specifying each category separately.

Version 1

Version 2

Foster Care Placement Effects

Column

Background

However, not all students who experience abuse tell someone about it. Does foster care placement impact whether students tell someone? Among those who disclose, who do they turn to?

A heatmap was not very helpful in visualizing these questions because the focus was on abuse score rather than on number of students per type of individual. The final radar plot builds on the second by changing the angle of the map, and clearly shows the relative distribution of students who tell each type of individual. Given the small sample size, adding annotations of percentages for each group didn’t seem to be of great value.

Version 1

Version 2

Column

Final Version

---
title: "Oregon Child Abuse Prevalence Study"
subtitle: "Synthesized Data"
output: 
  flexdashboard::flex_dashboard:
    theme: united
    source_code: embed
    vertical_layout: fill
    horizontal_layout: fill
---





```{r setup, include=FALSE}
library(flexdashboard)
library(reactable)
library(tidyverse)
library(colorblindr)
library(plotly)
library(here)
library(rio)
library(dplyr)
library(likert)
library(scales)
#theme_set(theme_minimal(legend.position= c(0.8, 0.2)))

raw <- import(here("data", "feb17_an.csv")) 


long <- raw %>% 
  pivot_longer(
    cols = c("Q3_1":"Q3_7", "Q3_8":"Q3_10"),
    names_to = "toss",
    values_to =  "stu_gender",
    values_drop_na = TRUE
  ) %>% 
  pivot_longer(
    cols = c("Q4_1":"Q4_19"),
    names_to = "toss1",
    values_to = "live_with",
    values_drop_na = TRUE
  ) %>% 
  pivot_longer(
    cols = c("Q16_1":"Q16_15","Q16_16"),
    names_to = "toss2",
    values_to = "ethnicity",
    values_drop_na = TRUE
  ) %>% 
  dplyr::select(c("id", "Q1", "Q2",
           "stu_gender", "live_with", "ethnicity",
           "Q9":"Q15",
           "Q17":"Q28",
           "Q46":"Q51B", 
           "Q52A", "Q52B", "Q52D",
           "Q53A", "Q53B", "Q53D",
           "Q54A", "Q54B", "Q54D",
           "Q55A", "Q56A", "Q57A",
           "Q58": "Q61",
           "Q106":"Q108",
           "Q162":"Q163_13",
           "SATOT":"PACFPERP"
  ))
  

ods <- long %>%
  mutate(district = factor(Q1),
         district = dplyr::recode(district,
                                'Siuslaw High School' = "Siuslaw",
                                'McKenzie High School' = "McKenzie",
                                'South Eugene High School' = "4J",
                                'Oakridge High School' = "Oakridge",
                                'Willamette High School' = "Bethel",
                                'Early College & Career Options (ECCO)' = "4J"),
         stu_gender = as.factor(stu_gender))

p <- ods %>% 
  select(Q162, district, PATOTR, SATOT, stu_gender) %>% 
  # filter(Q162 == "Yes" |
  #          Q162 == "No") %>% 
  mutate(total_abuse = PATOTR + SATOT) %>% 
  rename("Physical Abuse" = "PATOTR",
         "Sexual Abuse" = "SATOT" ) %>% 
  pivot_longer(
    cols = c("Physical Abuse", "Sexual Abuse"),
    names_to = "type_ab",
    values_to = "ab_scores"
) %>% 
  mutate(type_ab = as.factor(type_ab))

p <- p %>% 
  mutate(stu_gender = fct_recode(stu_gender,
             "Male"= '1',
             "Female" = '2',
             "Non-binary" = '3',
             "Non-binary" = '4',
             "Non-binary" ='5',
             "Non-binary" = '8',
              "NA" = '9')) %>% 
  rename(Gender = stu_gender)

p <- p %>% 
  group_by(type_ab, Gender, district) %>% 
  mutate(mean_ab = mean(total_abuse)) %>% 
  ungroup() 

```

Data Description {.sidebar}
=============================

**Background**

The plots displayed on this dashboard are generated from a synthetic dataset intended to represent original data from the *Oregon Child Abuse Prevalence Study (OCAPS) Pilot*.

**The OCAPS pilot surveys high school students across 5 school districts in Lane County to assess students' current experiences of abuse, harrassment, and social support.**

[Daniel Anderson](https://github.com/datalorax) produced this synthetic data using the [synthpop](https://cran.r-project.org/web/packages/synthpop/vignettes/synthpop.pdf) package.

[Akhila Nekkanti](https://github.com/akhilanekkanti1) created the plots shown using the [ggplot](https://ggplot2.tidyverse.org/reference/ggplot.html) package.

Background {data-orientation=rows} 
=========================


Row {data-height=600}
---------------------
### Click the image below to learn more about the Oregon Child Abuse Prevalence Study Pilot, conducted by the University of Oregon's Center for Prevention of Abuse and Neglect. {.no-title}

[![](kids_pic.png)](https://90by30.com/sites/90by30.com/files/resources/OCAPS%20Pilot%2010%20page%20Research%20Summary.pdf){target="_blank"}



Row 
-------------------------------
### Policymakers and funders rely heavily on state-wide child maltreatment data to prioritize public concerns, enact policy, and establish budgets for evidence-based programming (PEW Data Report, 2018). As such, the accurate translation of analyses with such data into visually compelling, easily digestible means is a critical pre-requisite to bridging the gap between advocates, researchers, and legislative bodies. In Oregon these data are dependent on either retrospective surveys with adults (Oregon BRFFS), youth convenience sample surveys with fewer than 10 abuse and neglect items (Oregon Healthy Teens Survey, Oregon Student Wellness Survey), and reports to child protective services (Children’s Bureau, 2019). This critical need for accurate data is met by a glaring gap as researchers and advocates agree that child maltreatment rates in the United States are significantly underreported (Swahn et al., 2006; Flaherty et al., 2008). University of Oregon’s Center for the Prevention of Abuse and Neglect (CPAN) implemented a pilot study to determine safer, more accurate methods of data collection in the school setting. Partnered with the Oregon Department of Education and multiple statewide agencies and advocacy groups, CPAN is currently implementing the first state-wide representative survey of abuse experiences with 1500-1800 youth in Oregon, to be completed in June 2021. 




Abuse Rates
===============================================

Column {.tabset .tabset-fade }
-----------------------------------------------------------------------
### Background

It's valuable to see how abuse rates across school districts in Lane County vary by gender identity. Often times, those who identify as non-binary are not inlcuded in analyses and visualizations due to small samples. A violin plot was helpful in visualizing the varying distributions by gender, but requires some thinking to fully understand. The final plot builds on the simplicity of the bar plot by allowing the reader to compare average scores across all three genders.


### Version 1

```{r plot1.1}

ggplot(p, aes(as.factor(type_ab), ab_scores)) +
	geom_violin(aes(fill=Gender)) +
  facet_wrap(~district) +
  labs(
    title = "Abuse Rates Across Districts"
  )

```

### Version 2

```{r plot1.2}

p %>% 
  filter(Gender == "Male" |
         Gender == "Female" |
           Gender == "Non-binary") %>% 
ggplot(aes(fct_reorder(district, mean_ab), mean_ab)) +
  geom_col(aes(fill = Gender), size = 5, position = position_dodge()) +
  facet_wrap(~type_ab, ncol = 1) +
  scale_color_brewer(palette = "Dark2") +
  coord_flip() +
  labs(
      title = "Average Abuse Scores",
  subtitle = "Results displayed by district, gender, and abuse type",
  x = "",
  y = "Average Score") +
  theme_minimal()

```

> Switched to bar plot, and collapsed gender variable.

Column 
-----------------------------------------------------------------------

### Final Version


```{r plot 1.3}


p %>% 
  filter(Gender == "Male" |
         Gender == "Female" |
           Gender == "Non-binary") %>% 
ggplot(aes(as.factor(district), mean_ab)) +
	geom_line(color = "gray70", size = 2) +
  geom_point(aes(color = Gender), size = 5) +
  facet_wrap(~type_ab, ncol = 1) +
  scale_color_brewer(palette = "Dark2") +
  coord_flip() +
  labs(
      title = "Average Abuse Scores",
  subtitle = "Results displayed by district, gender, and abuse type",
  x = "",
  y = "Average Score") +
  theme_minimal()

```


Community Response
=============

Column {data-height= 500}
-----------------------------------------------------------------------
### Final Version

```{r plot2.3, fig.height=6, fig.width=14}

levels1 <- c('Strongly disagree', 'Disagree', 'Agree', 'Strongly agree')

tell_lik <- raw %>% 
  select("Q164":"Q166") %>% 
  drop_na() %>% 
  mutate(Q164 = factor(Q164, levels = levels1),
         Q165 = factor(Q165, levels = levels1),
         Q166 = factor(Q166, levels = levels1))


tell_lik_long <- tell_lik %>% 
  rename("People listened with compassion." = "Q164",
         "People gave you the feeling that they understood your experience." = "Q165",
         "People helped you find a way to stop this from happening again." = "Q166") %>% 
  pivot_longer(
    cols = starts_with("People"),
    values_to = "category",
    names_to = "question",
    values_drop_na = TRUE
  ) %>% 
  group_by(question, category) %>% 
  add_tally() %>% 
  ungroup() 

sum_table <- tell_lik_long %>%
  select(question, n, category) %>% 
  group_by(question) %>%
  mutate(total = sum(n),
         pct = (n/total)*100,
         category = fct_relevel(category,
                                "Strongly disagree",
                                "Disagree",
                                "Agree",
                                "Strongly agree")) %>% 
  ungroup()



levels2 <- c('Strongly agree', 'Agree', 'Disagree', 'Strongly disagree')


sum_table <- sum_table %>%
  mutate(category = fct_relevel(category, levels2))

levels2 <- c('Strongly agree', 'Agree', 'Strongly disagree', 'Disagree')

sum_table1 <- sum_table %>% 
  mutate(category = fct_relevel(category, levels2),
         pct = pct* -1) %>% 
  filter(category == "Strongly disagree" |
           category == "Disagree")

wrapper <- function(x, ...) paste(strwrap(x, ...), collapse = "\n")
agreelab1 <- "87% Agree or Strongly Agree" 
dislab1 <- "12% Disagree or Strongly Disagree"


sum_table %>%
  mutate(category = fct_relevel(category, levels2)) %>% 
  filter(category == "Strongly agree" |
           category == "Agree") %>%
  group_by(question) %>% 
  mutate(totagree = sum(pct)) %>% 
  ungroup() %>% 
ggplot(aes(question, pct)) +
  geom_col(aes(fill = category)) +
  annotate("text", x = 3, y = 115, label = wrapper("88%", width = 10), size = 6) +
  annotate("text", x = 3, y = -20, label = wrapper("12%", width = 10), size = 6) +
  annotate("text", x = 2, y = 115, label = wrapper("82%", width = 10), size = 6) +
  annotate("text", x = 2, y = -20, label = wrapper("18%", width = 10), size = 6) +
  annotate("text", x = 1, y = 115, label = wrapper("80%", width = 10), size = 6) +
  annotate("text", x = 1, y = -20, label = wrapper("20%", width = 10), size = 6) +
  geom_col(aes(fill = category), data = sum_table1) +
  scale_fill_manual(values = c("#a6cee3","#b2df8a","#1f78b4","#33a02c")) +
  coord_flip() +
  scale_y_discrete(limits=c("Strongly disagree", "Disagree", "Agree", "Strongly agree")) +
  scale_x_discrete(labels = wrap_format(20)) + 
  geom_abline(aes(intercept = 0, slope = 0), 
               color = "grey40",
               linetype = 2, size = 1) +
  ylim(-35, 120) +
  labs(title = "Responses to Students' Disclosure of Abuse",
        x = "Percent",
        y = NULL,
        subtitle ="Overall, people respond compassionately."
  ) +
  theme(
        plot.title = element_text(size = 25),
        plot.subtitle = element_text(size = 20),
        panel.background = element_blank(),
        panel.grid.major.y = element_line("grey90"),
        axis.title.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y = element_text(size = 20),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        legend.position = "bottom",
        legend.title = element_blank(),
        legend.text = element_text(size = 15)) 
  
```

Column {.tabset .tabset-fade}
-----------------------------------------------------------------------
### Background

Researchers and policy makers alike are often hesitant to ask participants about their experiences in vulnerable settings (e.g., school) because they don’t want to trigger any past trauma. It’s helpful to see that when students tell others about their experience, the responses are often positive.

Using ggplot rather than the base Likert function in R, allows for “easy” modifcation of plot parameters. The first plot is clear, but is not malleable to changes in size or margins. The final plot builds on the stacked bar plot by layering agreeable responses over negatively coded disagreeable responses, across line. Given the very few disagreeable responses, it made greater sense to sum “Agree with Strongly Agree” and “Disagree with Strongly Disagree” rather than specifying each category separately.

### Version 1

```{r plot2.1}

tell_likresult = likert(tell_lik)
par(mai=c(12,8,8,12))
tellplot <- plot(tell_likresult, type = "bar",
                 
        main ="Responses After Students Disclose Their Experience",
        xlab ="X axis title",
        ylab = NULL,
        sub ="Overall, when students tell someone about an experience, people respond positively.",
        cex.main=2, cex.lab=1.7, cex.sub=1.2)

tellplot


```

### Version 2

```{r plot2.2}

ggplot(sum_table, aes(question, pct)) +
  geom_col(aes(fill = category))  +
  scale_fill_brewer(palette = "Paired") +
  coord_flip() +
  
  scale_x_discrete(labels = wrap_format(20)) + 
    geom_vline(aes(xintercept = 50), 
               color = "grey70",
               linetype = 4) +
  ylim(-5, 100) +
  labs(
    title = "Responses After Students Disclose Their Experience",
        x = "Percent",
        y = NULL,
        subtitle ="Overall, when students tell someone about an experience, people respond positively."
  ) +
  theme(
        plot.title = element_text(),
        plot.subtitle = element_text(),
    axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
    legend.position = "bottom",
    legend.title = element_blank()) 

```




Foster Care Placement Effects
================================

Column {.tabset .tabset-fade}
-----------------------------------------------------------------------
### Background

However, not all students who experience abuse tell someone about it. Does foster care placement impact whether students tell someone? Among those who disclose, who do they turn to?

A heatmap was not very helpful in visualizing these questions because the focus was on abuse score rather than on number of students per type of individual. The final radar plot builds on the second by changing the angle of the map, and clearly shows the relative distribution of students who tell each type of individual. Given the small sample size, adding annotations of percentages for each group didn't seem to be of great value.

### Version 1

```{r plot3.1}
radar <- raw %>%
  mutate(district = factor(Q1),
         district = dplyr::recode(district,
                                'Siuslaw High School' = "Siuslaw",
                                'McKenzie High School' = "McKenzie",
                                'South Eugene High School' = "4J",
                                'Oakridge High School' = "Oakridge",
                                'Willamette High School' = "Bethel",
                                'Early College & Career Options (ECCO)' = "4J"),
        Q163_1 = as.factor(Q163_1),
         Q163_2 = as.factor(Q163_2),
         Q163_3 = as.factor(Q163_3),
         Q163_4 = as.factor(Q163_4),
         Q163_5 = as.factor(Q163_5),
         Q163_6 = as.factor(Q163_6),
         Q163_7 = as.factor(Q163_7),
         Q163_8 = as.factor(Q163_8),
         Q163_9 = as.factor(Q163_9),
         Q163_10 = as.factor(Q163_10),
         Q163_11 = as.factor(Q163_11),
         Q163_12 = as.factor(Q163_12),
         Q163_13 = as.factor(Q163_13)) %>% 
  group_by(district) %>% 
  mutate(
    'Adverse Childhood Experiences' = mean(ACETOT),
    'Physical Abuse' = mean(PATOTR),
    'Sexual Abuse' = mean(SATOT)) %>% 
  ungroup()

radar$Q163_1 <- recode_factor(radar$Q163_1, "1" = "Teacher") 
radar$Q163_2 <- recode_factor(radar$Q163_2, "1" = "Doctor or Nurse")
radar$Q163_3 <-recode_factor(radar$Q163_3, "1" = "Parent")
radar$Q163_4 <-recode_factor(radar$Q163_4, "1" = "Extracurricular Adult") 
radar$Q163_5 <-recode_factor(radar$Q163_5, "1" = "Friend")
radar$Q163_6 <-recode_factor(radar$Q163_6, "1" = "Neighbor")
radar$Q163_7 <-recode_factor(radar$Q163_7, "1" = "Counselor")
radar$Q163_8 <-recode_factor(radar$Q163_8, "1" = "Pastor, Rabbi, Clergy")
radar$Q163_9 <-recode_factor(radar$Q163_9, "1" = "Non-Parent Adult Relative") 
radar$Q163_10 <-recode_factor(radar$Q163_10, "1" = "Sibling")
radar$Q163_11 <-recode_factor(radar$Q163_11, "1" = "Cousin or Non-Adult Relative")
radar$Q163_12 <-recode_factor(radar$Q163_12, "1" = "Other")
radar$Q163_13 <-recode_factor(radar$Q163_13, "1" = "I choose not to answer")
  
radar <- radar %>% 
  select(c("Adverse Childhood Experiences", "Physical Abuse", "Sexual Abuse", PATOTR, SATOT, ACETOT,Q28, district, Q12, starts_with("Q163_"), starts_with("Q3_"))) %>% 
  pivot_longer(
    cols = c("Adverse Childhood Experiences", "Physical Abuse", "Sexual Abuse"),
    names_to = "experience",
    values_to = "mean_scores",
    values_drop_na = TRUE)
radar <- radar %>% 
  pivot_longer(
    cols = starts_with("Q163_"),
    names_prefix = "Q163_",
    names_to = "toss",
    values_to = "told",
    values_drop_na = TRUE
)

radar <- radar %>% 
    pivot_longer(
    cols = c("Q3_1":"Q3_7", "Q3_8":"Q3_10"),
    names_to = "toss1",
    values_to =  "stu_gender",
    values_drop_na = TRUE
  ) 

radar <- radar %>% 
  mutate(stu_gender = as.factor(stu_gender),
    stu_gender = fct_recode(stu_gender,
             "Male"= '1',
             "Female" = '2',
             "Non-binary" = '3',
             "Non-binary" = '4',
             "Non-binary" ='5',
             "Non-binary" = '8',
              "NA" = '9')) %>% 
  rename(Gender = stu_gender) %>% 
  as.data.frame()

radar %>%
  filter(Q28 == "Strongly Agree" |
           Q28 == "Strongly Disagree" |
           Q28 == "Disagree" |
           Q28 == "Agree") %>% 
  mutate(adults = fct_recode(Q28,
                             "Yes" = 'Strongly Agree',
                             "Yes" = 'Agree',
                             "No" = 'Strongly Disagree',
                             "No" = 'Disagree')) %>% 
ggplot(aes(told, adults)) +
    geom_tile(aes(fill = PATOTR)) +
  scale_fill_viridis_c() +
  labs(
    fill = "Physical Abuse Score",
    x = NULL,
    y = "Placement in Foster Care",
    title = "How Foster Care Placement Relates to Who Students Tell About Experiences"
  ) +
  theme(
    legend.position = "bottom",
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(size = 10))
```

### Version 2

```{r plot3.2}

ggplot(radar, aes(x = told, y = mean_scores, colour = Q12, group = Q12)) +
  geom_line() +
  coord_polar(theta = "x") +
  scale_y_continuous() +
  scale_x_discrete(labels = wrap_format(10)) +
  labs(title = "") +
  theme(
    axis.text.y.left = element_text(vjust = 5),
    axis.title.y = element_blank()
  )


```


Column 
-----------------------------------------------------------------------

### Final Version


```{r plot 3.3}

ggplot(radar, aes(x = told)) +
  geom_bar(aes(fill = Q12), width = 1, color = "white") +
  coord_polar() + 
  scale_fill_manual(values = c("#a1d99b", "#31a354")) +
  scale_x_discrete(labels = wrap_format(10)) +
  labs(title = "Students are Most Likely to Disclose to Friends",
       subtitle = "Regardless of Foster Care Placement",
       y = NULL,
       x = NULL,
       fill = "Foster Care") 

```